home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / oper_sys / weyl / weyl_lsp.lha / algebraic-domains.lisp next >
Encoding:
Text File  |  1991-10-21  |  13.1 KB  |  565 lines

  1. ;;; -*- Mode:Lisp; Package:Weyli; Base:10; Lowercase:T; Syntax:Common-Lisp -*-
  2. ;;; ===========================================================================
  3. ;;;              Algebraic Domains
  4. ;;; ===========================================================================
  5. ;;; (c) Copyright 1989, 1991 Cornell University
  6.  
  7. ;;; $Id: algebraic-domains.lisp,v 2.13 1991/10/21 21:58:45 rz Exp $
  8.  
  9. (in-package "WEYLI")
  10.  
  11. (defclass set (domain)
  12.      ((equal-function :accessor set-elt-equal
  13.               :initarg :equality
  14.               :initform #'=))
  15.   (:documentation "A class for finite, unordered sets"))
  16.  
  17. (defgeneric = (x y))
  18. (defgeneric make-element (domain obj &rest rest))
  19.  
  20. ;; Define-opeartions for sets is in sets.lisp
  21.  
  22. (defclass SemiGroup (set)
  23.   ())
  24.  
  25. (define-operations semigroup
  26.   (times (element self) (element self)) -> (element self)
  27.   (expt (element self) positive-integer) -> (element self))
  28.  
  29. (defgeneric times (x y))
  30. (defgeneric expt (x y))
  31.  
  32. (defclass Monoid (semigroup)
  33.   ())
  34.  
  35. (define-operations Monoid
  36.   (one self) -> (element monoid)
  37.   (1? (element self)) -> Boolean
  38.   (expt (element self) integer) -> (element self))
  39.  
  40. (defgeneric one (x))
  41. (defgeneric 1? (x))
  42.  
  43. (defclass group (monoid)
  44.   ())
  45.  
  46. (define-operations group
  47.   (recip (element self)) -> (element self)
  48.   (expt (element self) Integer) -> (element self))
  49.  
  50. (defgeneric recip (x))
  51.  
  52. (defclass abelian-semigroup (set)
  53.   ())
  54.  
  55. (define-operations abelian-semigroup
  56.   (plus (element self) (element self)) -> (element self)
  57.   (times Integer (element self)) -> (element self))
  58.  
  59. (defgeneric plus (x y))
  60.  
  61. (defclass abelian-monoid (abelian-semigroup)
  62.   ())
  63.  
  64. (define-operations abelian-monoid
  65.   (zero self) -> (element self)
  66.   (0? (element self)) -> Boolean
  67.   (times integer (element self)) -> (element self))
  68.  
  69. (defgeneric zero (x))
  70. (defgeneric 0? (x))
  71.  
  72. (defclass ordered-abelian-monoid (abelian-monoid ordered-set)
  73.      ())
  74.  
  75. (defclass abelian-group (abelian-monoid)
  76.   ())
  77.  
  78. (define-operations abelian-group
  79.   (minus (element self)) -> (element self)
  80.   (difference (element self) (element self)) -> (element self)
  81.   (times integer (element self)) -> (element self))
  82.  
  83. (defgeneric minus (x))
  84. (defgeneric difference (x y))
  85.  
  86. (defclass ordered-abelian-group (abelian-group ordered-set)
  87.      ())
  88.  
  89. (defclass rng (semigroup abelian-group)
  90.   ())
  91.  
  92. (defclass simple-ring (rng monoid)
  93.   ((characteristic :initform 0
  94.            :initarg :characteristic
  95.            :reader ring-characteristic)))
  96.  
  97. (defmethod characteristic ((r rng))
  98.   (ring-characteristic r))
  99.  
  100. (define-operations simple-ring
  101.   (one self) -> (element self)
  102.   (1? (element self)) -> (element self)
  103.   (recip (element self)) -> (element self))
  104.  
  105. (defclass has-coefficient-domain ()
  106.   ((coefficient-domain :initform nil
  107.                :initarg :coefficient-domain
  108.                :reader coefficient-domain)))
  109.  
  110. (defvar *coefficient-domain* ()
  111.   "Within the context of a polynomial operation, the coefficient domain")
  112.  
  113. (defmethod %bind-dynamic-domain-context :around
  114.      ((domain has-coefficient-domain) function)
  115.   (with-slots (coefficient-domain) domain
  116.     (let ((*coefficient-domain* coefficient-domain))
  117.       (call-next-method domain function))))
  118.  
  119. (defclass module (abelian-group has-coefficient-domain)
  120.      ())
  121.  
  122. (defclass algebra (module semigroup)
  123.   ())
  124.  
  125. (defclass ring (algebra simple-ring)
  126.      ()
  127.   ;; Also has the distributive law
  128.   )
  129.  
  130. (defclass ordered-ring (ring ordered-set)
  131.      ())
  132.  
  133. (defgeneric > (x y))
  134. (defgeneric < (x y))
  135.  
  136. (defclass integral-domain (ring)
  137.      ()
  138.   ;; No zero divisors
  139.   )
  140.  
  141. (define-operations integral-domain
  142.   ;; Unit coefficient associate
  143.   (unit-normal (element self)) ->
  144.     (values (element self) (element self) (element self))
  145.   (associates? (element self) (element self)) -> Boolean
  146.   (unit? (element self)) -> Boolean)
  147.  
  148. (defclass gcd-domain (integral-domain)
  149.   ())
  150.  
  151. (define-operations gcd-domain
  152.   (gcd (element self) (element self)) -> (element self)
  153.   (lcm (element self) (element self)) -> (element self))
  154.  
  155. (defgeneric gcd (x y))
  156. (defgeneric lcm (x y))
  157.  
  158. (defclass unique-factorization-domain (gcd-domain)
  159.   ())
  160.  
  161. (define-operations unique-factorization-domain
  162.   (prime? (element self)) -> Boolean
  163.   (square-free (element self)) -> (element (factored-form self))
  164.   (factor (element self)) -> (element (factored-form self)))
  165.  
  166. (defclass euclidean-domain (gcd-domain)
  167.   ())
  168.  
  169. (define-operations euclidean-domain
  170.   (sizelp (element self) (element self)) -> boolean
  171.   (divide (element self) (element self)) -> (values (element self) (element self))
  172.   (quotient (element self) (element self)) -> (element self)
  173.   (remainder (element self) (element self)) -> (element self))
  174.  
  175. (defclass skew-field (ring)
  176.   ())
  177.  
  178. (defclass field (euclidean-domain unique-factorization-domain skew-field)
  179.   ())
  180.  
  181. (define-operations field
  182.   (quotient (element self) (element self)) -> (element self)
  183.   (recip (element self)) -> (element self))
  184.  
  185. (defclass finite-field (field finite-set)
  186.   ())
  187.  
  188. (defclass ordered-field (field ordered-set)
  189.      ())
  190.  
  191. (defclass algebraic-extension (ring)
  192.      ())
  193.  
  194. (defclass simple-field-extension (algebraic-extension field)
  195.      ())
  196.  
  197. ;; A domain that has a dimension
  198. (defclass dimensional-domain (domain)
  199.      ((dimension :initform nil
  200.          :initarg :dimension
  201.          :reader dimension)))
  202.  
  203. (defclass free-module (module dimensional-domain)
  204.      ())
  205.  
  206. (defclass vector-space (free-module)
  207.      ()
  208.   ;; Coefficient domain must be a field
  209.   )
  210.  
  211. (defclass projective-space (free-module)
  212.      ())
  213.  
  214. (defclass differential-ring (ring)
  215.      ())
  216.  
  217. (define-operations differential-ring
  218.   (deriv (element self)) -> (element self))
  219.  
  220. (defclass quotient-ring (domain)
  221.   ())
  222.  
  223. ;;; Concrete classes
  224.  
  225. ;; Lisp numbers
  226.  
  227. (defclass lisp-numbers (domain)
  228.   ())
  229.  
  230. ;; Sets
  231.  
  232. (defclass mutable-set (set)
  233.      ()
  234.   (:documentation "Sets built from this class can be modified"))
  235.  
  236. (defclass has-comparison ()
  237.      ((compare-function :accessor set-elt-greaterp
  238.             :initarg :compare-function))
  239.   )
  240.  
  241. (defclass ordered-set (set has-comparison)
  242.      ())
  243.  
  244. (defclass finite-set (set)
  245.      ())
  246.  
  247. (defclass set-element (domain-element)
  248.      ((key :reader element-key
  249.        :initarg :key)))
  250.  
  251. (defclass set-element1 (set-element)
  252.      ())
  253.  
  254. (defclass set-element2 (set-element)
  255.      ((value :accessor element-value
  256.          :initarg :value)))
  257.  
  258. (defclass set-elements-as-singletons (set)
  259.      ())
  260.  
  261. (defclass set-elements-as-pairs (set)
  262.      ())
  263.  
  264. (defclass set-with-element-list (set)
  265.      ((elements :accessor set-element-list
  266.         :initform (list nil)
  267.         :initarg :elements)))
  268.  
  269. (defclass mutable-set-with-element-list (set-with-element-list mutable-set)
  270.      ())
  271.  
  272. (defclass set-with-sorted-element-list (ordered-set set-with-element-list)
  273.      ())
  274.  
  275. (defclass mutable-set-with-sorted-element-list (ordered-set mutable-set-with-element-list)
  276.      ())
  277.  
  278. ;; The intiable sets classes
  279.  
  280. (defclass simple-set (mutable-set-with-element-list set-elements-as-singletons)
  281.   ())
  282.  
  283. (defclass set-of-pairs (mutable-set-with-element-list set-elements-as-pairs)
  284.   ())
  285.  
  286. (defclass ordered-simple-set
  287.     (mutable-set-with-sorted-element-list set-elements-as-singletons)
  288.   ())
  289.  
  290. (defclass ordered-set-of-pairs
  291.     (mutable-set-with-sorted-element-list set-elements-as-pairs) 
  292.   ())
  293.  
  294.  
  295. ;; Rational integers
  296.  
  297. (defclass rational-integers (gcd-domain caching-zero-and-one ordered-set)
  298.   ())
  299.  
  300. (defclass rational-integer (domain-element)
  301.      ((value :initarg :value
  302.          :accessor integer-value)))
  303.  
  304. ;; GFp
  305.  
  306. (defclass GFp (field)
  307.      ())
  308.  
  309. (defclass GFq (GFp)
  310.      ((degree :initarg :degree
  311.           :reader field-degree)))
  312.  
  313. (defclass GFp-element (domain-element)
  314.   ((value :reader gfp-value
  315.       :initarg :value)))
  316.  
  317. (defclass GF2^n (GFq)
  318.      ((reduction-table :initarg :reduction-table
  319.                :reader GFp-reduction-table)))
  320.  
  321. (defclass GFm (rng)
  322.   ())
  323.  
  324. (defclass GFm-element (domain-element)
  325.   ((value :initarg :value)
  326.    (modulus :initarg :modulus)))
  327.  
  328. (defclass simple-finite-field (field)
  329.   ())
  330.  
  331. ;; Bigfloat 
  332.  
  333. (defclass real-numbers (ordered-field)
  334.      ((precision :initform 28
  335.          :initarg :precision
  336.          :accessor fp-precision)))
  337.  
  338. (defclass bigfloat (domain-element)
  339.      ((mantissa :accessor bigfloat-mantissa
  340.         :initarg :mantissa)
  341.       (exponent :accessor bigfloat-exponent
  342.         :initarg :exponent)))
  343.  
  344. ;; Float
  345.  
  346. (defclass floating-point-numbers (ordered-field)
  347.      ())
  348.  
  349. (defclass complex-numbers (algebraic-extension field)
  350.      ())
  351.  
  352. ;; Quotient Fields
  353.  
  354. (defclass Quotient-Field (field)  
  355.   ((ring :initform nil :initarg :ring
  356.      :reader QF-ring)
  357.    (zero :initform nil)
  358.    (one :initform nil)))
  359.  
  360. (defclass quotient-element (domain-element)
  361.   ((numerator :accessor qo-numerator
  362.           :initarg :numerator)
  363.    (denominator :accessor qo-denominator
  364.         :initarg :denominator)))
  365.  
  366. ;;  Rational Numbers
  367.  
  368. (defclass rational-numbers (field ordered-set)
  369.      ())
  370.  
  371. (defclass rational-number (quotient-element)
  372.      ())
  373.  
  374. ;; Polynomials
  375.  
  376. ;; This is just the root of the polynomial structural type hierarchy.
  377. ;; It needs to be at the beginning of this file.
  378. (defclass polynomial (domain-element)
  379.      ())
  380.  
  381. ;; These are the pieces that are common to all polynomial domains and
  382. ;; polynomial representations.
  383. (defclass has-ring-variables ()
  384.      ((variables :initform nil
  385.          :initarg :variables
  386.          :reader ring-variables)))
  387.  
  388. ;;FIXTHIS  I don't think this is quite right.  I.e. Its not really a
  389. ;; GCD domain for any coefficient domain.
  390. (defclass polynomial-ring (gcd-domain module has-ring-variables)
  391.   ())
  392.  
  393. ;; Multivariate Polynomial rings need some structure to manage the their
  394. ;; variables.  This class provides hash tables and accessor methods of
  395. ;; this purpose.
  396. (defclass variable-hash-table (has-ring-variables)  
  397.   ((variable-hash-table :initform nil
  398.             :accessor variable-hash-table)
  399.    (variable-table :initform nil
  400.            :accessor variable-index-table)))
  401.  
  402. ;; Univariate polynomials only have a single variable, but they still
  403. ;; need all the accessing methods of the multivariate structures.
  404. (defclass single-variable-hash-table (has-ring-variables)  
  405.      ((variable :initform nil
  406.         :initarg :variable
  407.         :accessor svht-variable)
  408.       (variable-plist :initform nil
  409.               :accessor svht-variable-plist)))
  410.  
  411. ;; It is often useful to cache the values of zero and one since they are
  412. ;; often needed.  Need to include the class domain here to make
  413. ;; caching... more specific than just domain.
  414. (defclass caching-zero-and-one (domain)
  415.      ((zero)
  416.       (one)))
  417.  
  418.  
  419. ;; Multivariate polynomials
  420.  
  421. (defclass multivariate-polynomial-ring
  422.       (polynomial-ring variable-hash-table caching-zero-and-one)
  423.   ())
  424.  
  425. ;; The following are the two different representation that are used.
  426. ;; An mpolynomial uses a recursive structure in the variables, while a
  427. ;; epolynomial is an expanded representation that uses exponent vectors.
  428.  
  429. (defclass mpolynomial (polynomial)
  430.   ((form :accessor poly-form
  431.      :initarg :form)))
  432.  
  433. (defclass epolynomial (polynomial)  
  434.   ((form :accessor poly-form
  435.      :initarg :form)
  436.    (compare-function :accessor compare-function
  437.              :initarg :compare-function)))
  438.  
  439. ;; Univariate polynomials
  440.  
  441. (defclass univariate-polynomial-ring
  442.       (polynomial-ring single-variable-hash-table caching-zero-and-one)
  443.   ())
  444.  
  445. (defclass upolynomial (polynomial)
  446.   ((coef-list :accessor poly-form
  447.               :initarg :form)))
  448.  
  449. ;; Rational functions
  450.  
  451. (defclass rational-function-field (quotient-field)  
  452.   ())
  453.  
  454. (defclass rational-function (quotient-element)
  455.   ())
  456.  
  457. ;; Morphisms
  458.  
  459. (defclass morphism ()
  460.      ((domain :reader morphism-domain
  461.           :initarg :domain)
  462.       (map :reader morphism-map
  463.        :initarg :map)
  464.       (range :reader morphism-range
  465.          :initarg :range))
  466.   )
  467.  
  468. (defclass homomorphism (morphism)
  469.      ())
  470.  
  471. (defclass automorphism (homomorphism)
  472.      ())
  473.  
  474. ;; Differential domains
  475.  
  476. (defclass differential-polynomial-ring
  477.     (multivariate-polynomial-ring differential-ring)
  478.   ())
  479.  
  480. ;; Algebraic Extensions
  481.  
  482. (defclass algebraic-extension-ring 
  483.      (algebraic-extension multivariate-polynomial-ring)
  484.      ())
  485.  
  486. (defclass algebraic-object (mpolynomial)
  487.      ())
  488.  
  489.  
  490. ;; Direct Sums
  491.  
  492. ;; These are the root classes.  Classes like DIRECT-SUM-SEMIGROUP are
  493. ;; created in the direct-sum.lisp file along with several support
  494. ;; methods.
  495.  
  496. (defclass direct-sum (domain tuple) ())
  497.  
  498. (defclass direct-sum-element (domain-element tuple) ())
  499.  
  500.  
  501. ;; Vector Spaces
  502.  
  503. (defclass free-module-element (domain-element tuple)
  504.      ())
  505.  
  506. (defclass vector-space-element (free-module-element)
  507.      ())
  508.  
  509. ;; This optimization is included because lisp vectors are used as
  510. ;; exponents in the expanded polynomial representation.
  511. (defclass lisp-vector-space (vector-space)
  512.   ())
  513.  
  514. (defclass lisp-vector (vector-space-element)
  515.      ())
  516.  
  517. ;; Projective spaces
  518.  
  519. (defclass projective-space-element (vector-space-element)
  520.      ())
  521.  
  522. ;; Matrices
  523.  
  524. ;; This is is the domain of all matrices over a given ring.
  525. (defclass matrix-space (module) ())
  526.  
  527. (defclass GL-n (group has-coefficient-domain dimensional-domain) 
  528.      ()
  529.   (:documentation "General linear group"))
  530.  
  531. (defclass PSL-n (GL-n)
  532.      ())
  533.  
  534. (defclass SL-n (PSL-n)
  535.      ())
  536.  
  537. (defclass O-n (GL-n)
  538.      ())
  539.  
  540. (defclass SO-n (O-n)
  541.      ())
  542.  
  543. (defclass matrix-element (domain-element)
  544.      ((value :initarg :value
  545.          :reader matrix-value)))
  546.  
  547. (defclass matrix-space-element (matrix-element)
  548.      ((dimension1 :initarg :dimension1)
  549.       (dimension2 :initarg :dimension2)))
  550.  
  551. (defclass GL-n-element (matrix-element)
  552.      ())
  553.  
  554. (defclass PSL-n-element (GL-n-element)
  555.      ())
  556.  
  557. (defclass SL-n-element (PSL-n-element)
  558.      ())
  559.  
  560. (defclass O-n-element (GL-n-element)
  561.      ())
  562.  
  563. (defclass SO-n-element (O-n-element)
  564.      ())
  565.